with Ada.Unchecked_Deallocation;
with ada.text_io; use Ada.text_io;

package body ariane.elemental.autoptr is

  -- instantiate a wrapper deallocation procedure
  procedure free_wrapper is new Ada.Unchecked_Deallocation
    (Object=> wrapper_t, Name => wrapper_access);

  -- returns the targeted object poiner 'p' points to
  function target(p : Pointer) return target_t is
  begin
    -- wrapper is guaranteed to be available
    -- if not an exception should be thrown by the system for now
    return p.wrapper.target;
  end target;

  -- creates an new instance of target and returns a pointer that points to it
  function create return Pointer is
    p : Pointer;
  begin
    put_line("creating");

    p.wrapper := new wrapper_t;
    put_line(" step 1");

    if target_initialize /= null then
      target_initialize(p.wrapper.target);
    end if;
    put_line(" step 2");

    p.wrapper.reference_counter := 1;
    put_line(" step 3");

    put_line("'create' returning");
    return p;
  end create;

  -- override of equal sign that returns if two pointers are considered equal
  -- in which case they are pointing to the same wrapper/target
  function "="(left, right : Pointer) return boolean is
  begin
    return left.wrapper = right.wrapper;
  end "=";

  -- returns the number of pointers referencing the target pointer p points tos
  function numrefs(p : Pointer) return integer is
  begin
    if p.wrapper = null then
      return 0;
    end if;

    return p.wrapper.reference_counter;
  end numrefs;

  -- private methods

  -- finalizes the target and release the allocation
  procedure finalize_wrapper(p : in out wrapper_access) is
  begin
    if target_finalize /= null then
      target_finalize(p.target);
    end if;

    free_wrapper(p);
  end finalize_wrapper;

  -- initializer
  overriding procedure Initialize(p : in out Pointer) is
  begin
    put_line("initializing");
    null;  -- do nothing; what could be done is instantiate a wrapper
    put_line("initialized");
  end Initialize;

  -- adjuster that is called after assignment of 'p'
  overriding procedure Adjust(p : in out Pointer) is
  begin
    put_line("adjusting");
    p.wrapper.reference_counter := p.wrapper.reference_counter + 1;
    put_line("adjusted");
  end Adjust;

  overriding procedure Finalize(p : in out Pointer) is
  begin
    put_line("finalizing");
    if p.wrapper = null then
      put_line(" wrapper is null");
      return;
    end if;

    p.wrapper.reference_counter := p.wrapper.reference_counter - 1;
    put(" refcount = "); put_line(integer'Image(p.wrapper.reference_counter));
    -- allowing 'less than' is purely for tolerating erroneous condition
    if p.wrapper.reference_counter <= 0 then
      finalize_wrapper(p.wrapper);
    end if;
    put_line("finalized");
  end Finalize;

begin
  null;
end ariane.elemental.autoptr;
